home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / PGM_TOOL / TPRCDR10 / EXTS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-26  |  5KB  |  163 lines
  1. { ╔═══════════╤════════════════════════════════════════════════╗
  2.   ║ Programmer│ Tony Papadimitriou                             ║
  3.   ║ Program   │ EXTS                                           ║
  4.   ║ Uses      │ Dos, TPUtils, TPRecDir                         ║
  5.   ║ Includes  │ Nothing                                        ║
  6.   ║ Links     │ Nothing                                        ║
  7.   ║ Created   │ Sunday, December 19, 1993  2:08 am             ║
  8.   ║ Updated   │ Saturday, December 25, 1993 11:29 pm           ║
  9.   ║ Language  │ (MSDOS) Turbo Pascal 6.0                       ║
  10.   ║ Purpose   │ Show off TPRecDir unit                         ║
  11.   ╟───────────┴┬──────── Version History ──────────────────────╢
  12.   ║ 1.00       │Original                                       ║
  13.   ╚════════════╧═══════════════════════════════════════════════╝ }
  14. uses
  15.   Dos,
  16.   TPUtils,
  17.   TPRecDir;
  18.  
  19. const
  20.   progName = 'EXTS';
  21.   version  = '1.00';
  22.  
  23. procedure Copyright;
  24. begin
  25.   Writeln(stderr);
  26.   Writeln(stderr,progName+' ver. ' + version + ' ■ Copyright (c) 1993-94 by Tony G. Papadimitriou *FREEWARE*');
  27.   Writeln(stderr);
  28. end; { Copyright }
  29.  
  30. type
  31.   String3 = String[ 3 ]; { used for storing extensions }
  32.  
  33.   PLinkedList = ^TLinkedList;
  34.   TLinkedList = record
  35.     data: String3;       { extension }
  36.     size: Word;          { counter for occurrences of data }
  37.     next: PLinkedList;   { pointer to next node }
  38.   end; { TLinkedList }
  39.  
  40. var
  41.   totalMatches : Longint;
  42.   head         : PLinkedList;
  43.  
  44. procedure AddNode(data: String3); { add in alphabetical order }
  45. var
  46.   searchPos,
  47.   previous,
  48.   current: PLinkedList;
  49. begin
  50.   data := UpWord(data);
  51.   New(current);
  52.   current^.data := data;
  53.   current^.size := 1;
  54.   current^.next := NIL;
  55.   if head = NIL then
  56.     head := current
  57.   else
  58.   begin
  59.     searchPos := head;
  60.     previous := head;
  61.     while (searchPos <> NIL) and (data > searchPos^.data) do
  62.     begin
  63.       previous := searchPos;
  64.       searchPos := searchPos^.next;
  65.     end; { while }
  66.     if head = searchPos then
  67.     begin
  68.       current^.next := head;
  69.       head := current;
  70.     end
  71.     else
  72.     begin
  73.       current^.next := previous^.next;
  74.       previous^.next := current;
  75.     end; { else }
  76.   end; { else }
  77. end; { AddNode }
  78.  
  79. procedure AddUniqueNode(data: String3); { add a node that does not exist in list }
  80. var
  81.   p: PLinkedList;
  82. begin
  83.   data := UpWord(data);
  84.   p := head;
  85.   while (p <> NIL) and (data <> p^.data) do
  86.     p := p^.next;
  87.   if p = NIL then
  88.     AddNode(data)
  89.   else
  90.     Inc(p^.size);
  91. end; { AddUniqueNode }
  92.  
  93. procedure ShowNodes;
  94. var
  95.   p,
  96.   kill: PLinkedList;
  97.   count: Word;
  98. begin
  99.   count := 0;
  100.   Writeln('╔═════╤═════╦═════╤═════╦═════╤═════╦═════╤═════╦═════╤═════╦═════╤═════╗');
  101.   Writeln('║ Ext │ Num ║ Ext │ Num ║ Ext │ Num ║ Ext │ Num ║ Ext │ Num ║ Ext │ Num ║');
  102.   Writeln('╠═════╪═════╬═════╪═════╬═════╪═════╬═════╪═════╬═════╪═════╬═════╪═════╣');
  103.   p := head;
  104.   while p <> NIL do
  105.   begin
  106.     Write('║ ',Left(p^.data,3,' '),' │',p^.size:5);
  107.     kill := p;
  108.     p := p^.next;
  109.     Dispose(kill);
  110.     Inc(count);
  111.     if (count mod 6) = 0 then Writeln('║');
  112.   end; { while }
  113.   while (count mod 6) <> 0 do
  114.   begin
  115.     Write('║     │     ');
  116.     Inc(count);
  117.     if (count mod 6) = 0 then Writeln('║');
  118.   end; { while }
  119.   Writeln('╚═════╧═════╩═════╧═════╩═════╧═════╩═════╧═════╩═════╧═════╩═════╧═════╝');
  120. end; { ShowNodes }
  121.  
  122. { --- this is the user routine whose address you must supply to ForEachFileIn }
  123. function List(rec: SearchRec): Boolean; far;
  124. var
  125.   dir: DirStr;
  126.   nam: NameStr;
  127.   ext: ExtStr;
  128. begin
  129.   List := True;
  130.   ShowProgressHere;
  131.   if not AttributeMatches(rec.attr,Directory) then
  132.   begin
  133.     Inc(totalMatches);
  134.     FSplit(rec.name,dir,nam,ext);
  135.     AddUniqueNode(Copy(ext,2,Length(ext)));
  136.   end;
  137. end; { List }
  138.  
  139. var
  140.   path : PathStr;
  141.   mask : String;
  142. begin
  143.   Copyright;
  144.   if ParamCount = 0 then
  145.   begin
  146.     Writeln(stderr,'Usage: EXTS [<path>\]<mask>[;<mask>]');
  147.     Writeln(stderr);
  148.     Writeln(stderr,'       Press ESC during search to interrupt prematurely.');
  149.     Halt;
  150.   end; { if }
  151.   head := NIL;
  152.   totalMatches := 0;
  153.   path := ParamStr(1);
  154.   mask := GetMask(path);
  155.   path := GetPath(path);
  156.   Write(stderr,'Working  ');
  157.   ForEachFileIn(path,mask,AnyFile,True,True,@List);
  158.   BlankLine;
  159.   if errorsFound then Writeln(stderr,'Errors during processing!');
  160.   ShowNodes;
  161.   Writeln(stderr,totalMatches,' match'+OneManyStr(totalMatches,'','es')+' found!');
  162. end.
  163.